home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue36 / construc / ROBOTFTP.DPR < prev    next >
Encoding:
Text File  |  1998-06-30  |  4.0 KB  |  140 lines
  1. program RobotFTP;
  2. {$I+}
  3. {$APPTYPE CONSOLE}
  4. uses
  5.   Windows, WinINet, SysUtils, DrBobCGI, DrBobUUE, DrBobEml;
  6.  
  7.   procedure CopyURL(const URL, OutputFile: String);
  8.   const
  9.     BufferSize = 8 * 1024;
  10.   var
  11.     hSession, hURL: HInternet;
  12.     Buffer: array[0..Pred(BufferSize)] of Byte;
  13.     BufferLength: DWORD;
  14.     i: Integer;
  15.     f: File;
  16.   begin
  17.     hSession := InternetOpen('DrBob',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0);
  18.     try
  19.       hURL := InternetOpenURL(hSession, PChar(URL), nil,0,0,0);
  20.       try
  21.         Assign(f, OutputFile);
  22.         Rewrite(f,1);
  23.         writeln('Downloading...<P>');
  24.         i := 0;
  25.         repeat
  26.           InternetReadFile(hURL, @Buffer, BufferSize, BufferLength);
  27.           inc(i);
  28.           if (i in [1,2,4,8,16,32,64]) or (i mod 64 = 0) then
  29.             writeln(i*8,'KBytes...<BR>');
  30.           BlockWrite(f, Buffer, BufferLength)
  31.         until BufferLength < BufferSize;
  32.         Close(f);
  33.         writeln('<BR>',(i-1)*BufferSize + BufferLength,' Bytes downloaded.');
  34.       finally
  35.         InternetCloseHandle(hURL)
  36.       end
  37.     finally;
  38.       InternetCloseHandle(hSession)
  39.     end
  40.   end;
  41.  
  42. var
  43.   f: Text;
  44.   Str: String;
  45.   counter: Integer;
  46. begin
  47.   ShortDateFormat := 'YYYY/MM/DD';
  48.   writeln('content-type: text/html');
  49.   writeln;
  50.   writeln('<HTML>');
  51.   writeln('<HEAD>');
  52.   writeln('<TITLE>',Value('URL'),' -> ',Value('File'),'</TITLE>');
  53.   writeln('</HEAD>');
  54.   writeln('<BODY BACKGROUND="/gif/back.gif">');
  55.   writeln('<H1>RobotBob/FTP v1.0</H1>');
  56.   writeln('<HR>');
  57.   writeln('<BR>URL=',Value('URL'));
  58.   writeln('<BR>File=',Value('File'));
  59.   writeln('<BR>Mail=',Value('Mail'));
  60.   writeln('<P>');
  61.   ChDir('RobotBob'); { place to leave FTP-files }
  62.   {$I-}
  63.   Assign(f,'robotbob.log');
  64.   Reset(f);
  65.   counter := 0;
  66.   if IOResult = 0 then while not eof(f) do
  67.   begin
  68.     readln(f);
  69.     Inc(counter)
  70.   end
  71.   else Rewrite(f);
  72.   if IOResult <> 0 then { skip };
  73.   Append(f);
  74.   Inc(counter);
  75.   writeln(f,counter:4,': ',Value('URL'),' -> ',Value('File'),' to ',Value('Mail'));
  76.   Close(f);
  77.   if IOResult <> 0 then { skip };
  78.   writeln('Request #',counter,' at ',DateTimeToStr(Now),'<P>');
  79.   {$I+}
  80.   ChDir('FTP');
  81.   if (Value('URL') <> '') and (Value('File') <> '') then
  82.   begin
  83.     CopyURL(Value('URL'), ExtractFileName(Value('File')));
  84.     if Value('Mail') <> '' then
  85.     begin
  86.       with TBUUCode.Create(nil) do
  87.       try
  88.         InputFile := ExtractFileName(Value('File'));
  89.         Str := InputFile;
  90.         if Pos('.',Str) > 0 then Delete(Str,Pos('.',Str),255);
  91.         if Str = '' then Str := 'output';
  92.         OutputFile := Str + '.uue';
  93.         Algorithm := uuencode;
  94.         try
  95.           UUCode;
  96.           with TBSMTP.Create(nil) do
  97.           try
  98.             MailServer := 'smtp.server.com';
  99.             MessageFrom := 'RobotBob';
  100.             MessageTo := Value('Mail');
  101.             MessageSubject := 'Automatic E-mail using SMTP';
  102.             MessageText.Add('Hi '+Value('Mail')+',');
  103.             MessageText.Add('');
  104.             MessageText.Add('URL='+Value('URL'));
  105.             MessageText.Add('File='+Value('File'));
  106.             MessageText.Add('UUCode='+OutputFile);
  107.             MessageText.Add('Mail='+Value('Mail'));
  108.             MessageText.Add('');
  109.             System.Assign(f,OutputFile);
  110.             Reset(f);
  111.             while not eof(f) do
  112.             begin
  113.               readln(f,Str);
  114.               MessageText.Add(Str)
  115.             end;
  116.             System.Close(f);
  117.             Erase(f);
  118.             MessageText.Add('');
  119.             MessageText.Add('Groetjes,');
  120.             MessageText.Add('           RobotBob - RobotBob@drbob42.com');
  121.             writeln('<P>Sending mail to ',Value('Mail'),'...');
  122.             SendMail;
  123.             writeln('<P>Sent.');
  124.           finally
  125.             Free
  126.           end
  127.         except
  128.           on E: Exception do
  129.             writeln(E.Message)
  130.         end
  131.       finally
  132.         writeln('<P>Done.');
  133.         Free
  134.       end
  135.     end
  136.   end;
  137.   writeln('</BODY>');
  138.   writeln('</HTML>')
  139. end.
  140.